home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / qbsnip.zip / MSWIND.ZIP / MSWIND.BAS next >
BASIC Source File  |  1997-06-19  |  12KB  |  436 lines
  1. '---------------------------------------------------
  2. '  MSWIND.BAS - Microsoft Windows Utils for QB 4.5
  3. '---------------------------------------------------
  4. '       (c) Carl Gorringe 1/15/96
  5. '
  6. ' This program contains some routines to
  7. '  report if Windows is running, and to
  8. '   read and write to its Clipboard.
  9. '
  10. ' Remember to have Windows loaded or else
  11. ' the Clipboard routines WILL NOT WORK!!
  12. '
  13. '    Released to the Public Domain.
  14. '  You may use this any way you see fit,
  15. '  just remember to give credit where
  16. '  credit is due. This program is provided
  17. '  "AS IS", therefore I am not responsible
  18. '  for any consequences of using it.
  19. '
  20. ' I can be contacted be sending a message to:
  21. ' CARL GORRINGE at FIDOnet's QUICK_BAS echo or
  22. ' Internet e-mail: <carl.gorringe@rhosoft.com>
  23.  
  24. '-------------------
  25. ' $INCLUDE: 'QB.BI'      <-- Remember to load QB with the /L switch!
  26. '-------------------
  27.  
  28. CONST FALSE = 0
  29. CONST TRUE = NOT FALSE
  30.  
  31. DECLARE FUNCTION Info.DOSver% ()
  32. DECLARE FUNCTION Info.WinMode% ()
  33. DECLARE FUNCTION Clipboard.Detect% ()
  34. DECLARE FUNCTION Clipboard.Size& (Format%, ErrCode%)
  35. DECLARE SUB Clipboard.Empty (ErrCode%)
  36. DECLARE SUB Clipboard.Get (Format%, DataSeg%, DataOff%, ErrCode%)
  37. DECLARE SUB Clipboard.Put (Format%, DataSeg%, DataOff%, DataSize&, ErrCode%)
  38. DECLARE FUNCTION Clipboard.GetText$ (ErrCode%)
  39. DECLARE SUB Clipboard.PutText (Text$, ErrCode%)
  40.  
  41. '---------------------------------------------------
  42. CLS
  43. PRINT "MSWIND.BAS - Programmed by Carl Gorringe <carl.gorringe@rhosoft"+ ".com>"
  44. PRINT
  45. PRINT "DOS Version:", (Info.DOSver% / 100)
  46. PRINT "Windows Mode:", Info.WinMode%
  47.  
  48. ClipExist% = Clipboard.Detect%
  49. IF ClipExist% THEN
  50.     PRINT "Clipboard:", " Available"
  51. ELSE
  52.     PRINT "Clipboard:", " N/A"
  53. END IF
  54.  
  55. IF ClipExist% THEN
  56.  
  57.     '--- Store Text on Clipboard ---
  58.         PRINT
  59.         INPUT "Enter some text to store on the Clipboard: ", ClipText$
  60.  
  61.         CALL Clipboard.PutText(ClipText$, ErrCode%)
  62.         PRINT
  63.         PRINT "   ClipText:", ClipText$
  64.         PRINT "    ErrCode:", ErrCode%
  65.         IF ErrCode% <> 0 THEN END
  66.  
  67.         ClipText$ = ""             '<-- Clear Variable
  68.  
  69.         PRINT
  70.         PRINT "Now press [CTRL]+[ESC] to switch to Windows and check"+ " the Clipboard."
  71.         PRINT "Press Any Key to Retrieve the Clipboard contents..."
  72.         I$ = INPUT$(1)
  73.  
  74.     '--- Retrieve Text from Clipboard ---
  75.  
  76.         Format% = 7
  77.         Size& = Clipboard.Size&(Format%, ErrCode%)
  78.  
  79.         PRINT
  80.         PRINT "     Format:", Format%
  81.         PRINT "       Size:", Size&; "bytes"
  82.         PRINT "    ErrCode:", ErrCode%
  83.         IF ErrCode% <> 0 THEN END
  84.  
  85.         ClipText$ = Clipboard.GetText$(ErrCode%)
  86.         PRINT "   ClipText:", ClipText$
  87.         PRINT "    ErrCode:", ErrCode%
  88.  
  89. END IF
  90.  
  91. FUNCTION Clipboard.Detect%
  92.  
  93. '  (c) Carl Gorringe 1/15/96
  94. '------------------------------------------
  95. '  Returns TRUE (-1) if Windows Clipboard
  96. '  is Detected, else returns FALSE (0).
  97. '------------------------------------------
  98. '<< Done - Tested OK >>
  99.  
  100. DIM InReg AS RegType, OutReg AS RegType
  101.  
  102. ClipMode% = FALSE
  103. WinMode% = Info.WinMode%
  104.  
  105. IF WinMode% > 1 THEN
  106.   InReg.ax = &H1700
  107.   CALL INTERRUPT(&H2F, InReg, OutReg)
  108.   IF OutReg.ax = &H1700 THEN
  109.      ClipMode% = FALSE
  110.   ELSE
  111.      ClipMode% = TRUE
  112.   END IF
  113. END IF
  114.  
  115. Clipboard.Detect% = ClipMode%
  116.  
  117. END FUNCTION
  118.  
  119. SUB Clipboard.Empty (ErrCode%)
  120.  
  121. '  (c) Carl Gorringe 1/15/96
  122. '---------------------------------------------
  123. '  Empties the Clipboard
  124. '  ErrCode% is the Error Code returned: 0=OK
  125. '---------------------------------------------
  126. '<< Done - Tested OK >>
  127.  
  128. DIM InReg AS RegType, OutReg AS RegType
  129. DIM InRegX AS RegTypeX, OutRegX AS RegTypeX
  130.  
  131. '--- Open Clipboard ---
  132.     InReg.ax = &H1701
  133.     CALL INTERRUPT(&H2F, InReg, OutReg)
  134.     IF OutReg.ax = 0 THEN
  135.         ErrCode% = 1                  '<-- Clipboard is already open_
  136. ' (error)
  137.         EXIT SUB
  138.     END IF
  139.  
  140. '--- Empty Clipboard ---
  141.     InReg.ax = &H1702
  142.     CALL INTERRUPT(&H2F, InReg, OutReg)
  143.     IF OutReg.ax = 0 THEN
  144.         ErrCode% = 3                  '<-- Failure (error)
  145.     END IF
  146.  
  147. '--- Close Clipboard ---
  148.     InReg.ax = &H1708
  149.     CALL INTERRUPT(&H2F, InReg, OutReg)
  150.     IF OutReg.ax = 0 THEN
  151.         ErrCode% = 2                  '<-- Clipboard wont close (error)
  152.         EXIT SUB
  153.     END IF
  154.  
  155.  
  156. END SUB
  157.  
  158. SUB Clipboard.Get (Format%, DataSeg%, DataOff%, ErrCode%)
  159.  
  160. '  (c) Carl Gorringe 1/15/96  << v1.0 >>
  161. '---------------------------------------------
  162. '  Gets Data from the Clipboard and stores
  163. '  it at address DataSeg% : DataOff%
  164. '  ErrCode% is the Error Code returned: 0=OK
  165. '  Format% is the clipboard format number:
  166. '         1 = Text (Windows Text)  <-- Contains garbage chars at end of text
  167. '         2 = Bitmap Picture
  168. '         3 = Metafile Picture
  169. '         7 = OEM Text (DOS Text)  <-- Contains nulls at end of text
  170. '---------------------------------------------
  171. '<< Done - Tested OK >>
  172.  
  173. DIM InReg AS RegType, OutReg AS RegType
  174. DIM InRegX AS RegTypeX, OutRegX AS RegTypeX
  175.  
  176. '--- Open Clipboard ---
  177.     InReg.ax = &H1701
  178.     CALL INTERRUPT(&H2F, InReg, OutReg)
  179.     IF OutReg.ax = 0 THEN
  180.         ErrCode% = 1                  '<-- Clipboard is already open (error)
  181.         EXIT SUB
  182.     END IF
  183.  
  184. '--- Get Clipboard Data ---
  185.     InRegX.ax = &H1705
  186.     InRegX.dx = Format%
  187.     InRegX.es = DataSeg%
  188.     InRegX.bx = DataOff%
  189.     CALL INTERRUPTX(&H2F, InRegX, OutRegX)
  190.     IF OutRegX.ax = 0 THEN
  191.         ErrCode% = 3                  '<-- (error)
  192.     END IF
  193.  
  194. '--- Close Clipboard ---
  195.     InReg.ax = &H1708
  196.     CALL INTERRUPT(&H2F, InReg, OutReg)
  197.     IF OutReg.ax = 0 THEN
  198.         ErrCode% = 2                  '<-- Clipboard wont close (error)
  199.         EXIT SUB
  200.     END IF
  201.  
  202. END SUB
  203.  
  204. FUNCTION Clipboard.GetText$ (ErrCode%)
  205.  
  206. '  (c) Carl Gorringe 1/15/96  << v1.0 >>
  207. '-----------------------------------------------------
  208. '  Gets and Returns Text Data from the Clipboard.
  209. '  Clipboard Format used is "OEM Text" (Format% = 7)
  210. '  ErrCode% is the Error Code returned: 0=OK
  211. '-----------------------------------------------------
  212. '<< Done - Tested OK >>
  213.  
  214. ErrCode% = 0
  215. Format% = 1       '<-- 7=OEM Text, 1=Windows Text
  216.  
  217. '--- Get Size of Clipboard ---
  218.     Size& = Clipboard.Size&(Format%, ErrCode%)
  219.     IF ErrCode% > 0 THEN EXIT FUNCTION
  220.  
  221.     IF Size& = 0 THEN
  222.         ErrCode% = 4         '<-- Clipboard Empty!
  223.         EXIT FUNCTION
  224.     END IF
  225.  
  226.     IF Size& > 32000 THEN
  227.         ErrCode% = 5         '<-- Clipboard Too Large for String Variable!
  228.         EXIT FUNCTION
  229.     END IF
  230.  
  231. '--- Get Text from Clipboard and Store It ---
  232.     Temp$ = SPACE$(Size&)
  233.     CALL Clipboard.Get(Format%, VARSEG(Temp$), SADD(Temp$), ErrCode%)
  234.  
  235.     IF ErrCode% = 0 THEN
  236.         '--- Trim Ending Garbage ---
  237.             Temp$ = LEFT$(Temp$, INSTR(Temp$, CHR$(0)) - 1)
  238.  
  239.         '--- Trim Ending CR/LF if Exists ---
  240.             IF RIGHT$(Temp$, 2) = CHR$(13) + CHR$(10) THEN
  241.                 Temp$ = LEFT$(Temp$, LEN(Temp$) - 2)
  242.             END IF
  243.  
  244.         Clipboard.GetText$ = Temp$
  245.     END IF
  246.  
  247. END FUNCTION
  248.  
  249. SUB Clipboard.Put (Format%, DataSeg%, DataOff%, DataSize&, ErrCode%)
  250.  
  251. '  (c) Carl Gorringe 1/15/96  << v1.0 >>
  252. '---------------------------------------------
  253. '  Stores Data on to the Clipboard starting
  254. '  from address DataSeg% : DataOff%
  255. '    and storing DataSize& bytes.
  256. '  ErrCode% is the Error Code returned: 0=OK
  257. '  Format% is the clipboard format number:
  258. '         1 = Text (Windows Text)
  259. '         2 = Bitmap Picture
  260. '         3 = Metafile Picture
  261. '         7 = OEM Text (DOS Text)
  262. '---------------------------------------------
  263. '<< Done - Tested OK >>
  264.  
  265. DIM InReg AS RegType, OutReg AS RegType
  266. DIM InRegX AS RegTypeX, OutRegX AS RegTypeX
  267.  
  268. '--- Open Clipboard ---
  269.     InReg.ax = &H1701
  270.     CALL INTERRUPT(&H2F, InReg, OutReg)
  271.     IF OutReg.ax = 0 THEN
  272.         ErrCode% = 1                  '<-- Clipboard is already open (error)
  273.         EXIT SUB
  274.     END IF
  275.  
  276. '--- Store Clipboard Data ---
  277.     InRegX.ax = &H1703
  278.     InRegX.dx = Format%
  279.     InRegX.es = DataSeg%
  280.     InRegX.bx = DataOff%
  281.     IF DataSize& < 32768 THEN
  282.         InRegX.si = 0
  283.         InRegX.cx = DataSize&
  284.     ELSE
  285.         InRegX.si = (DataSize& \ 32768) * 2048   '<-- This part NOT Tested!
  286.         InRegX.cx = DataSize& MOD 32768          '<-- but don't worry about it.
  287.     END IF
  288.  
  289.     CALL INTERRUPTX(&H2F, InRegX, OutRegX)
  290.     IF OutRegX.ax = 0 THEN
  291.         ErrCode% = 3                  '<-- (error)
  292.     END IF
  293.  
  294. '--- Close Clipboard ---
  295.     InReg.ax = &H1708
  296.     CALL INTERRUPT(&H2F, InReg, OutReg)
  297.     IF OutReg.ax = 0 THEN
  298.         ErrCode% = 2                  '<-- Clipboard wont close (error)
  299.         EXIT SUB
  300.     END IF
  301.  
  302. END SUB
  303.  
  304. SUB Clipboard.PutText (Text$, ErrCode%)
  305.  
  306. '  (c) Carl Gorringe 1/15/96  << v1.0 >>
  307. '---------------------------------------------
  308. '  Stores Text on to the Clipboard in
  309. '     BOTH Clipboard Text Formats.
  310. '  ErrCode% is the Error Code returned: 0=OK
  311. '---------------------------------------------
  312. '<< Done - Tested OK >>
  313.  
  314. ErrCode% = 0
  315.  
  316. '--- Empty Clipboard ---
  317.     CALL Clipboard.Empty(ErrCode%)
  318.     IF ErrCode% <> 0 THEN
  319.         ErrCode% = ErrCode% + 10
  320.         EXIT SUB
  321.     END IF
  322.  
  323. '--- Store Text on to Clipboard ---
  324.     Temp$ = Text$ + CHR$(0)
  325.     TempLen& = LEN(Temp$)
  326.  
  327.     CALL Clipboard.Put(1, VARSEG(Temp$), SADD(Temp$), TempLen&, ErrCode%)
  328.     CALL Clipboard.Put(7, VARSEG(Temp$), SADD(Temp$), TempLen&, ErrCode%)
  329.  
  330.  
  331. END SUB
  332.  
  333. FUNCTION Clipboard.Size& (Format%, ErrCode%)
  334.  
  335. '  (c) Carl Gorringe 1/15/96  << v1.0 >>
  336. '---------------------------------------------
  337. '  Returns the current size of the Clipboard
  338. '  in bytes, using the specified Format%
  339. '  ErrCode% is the Error Code returned: 0=OK
  340. '  Format% is the clipboard format number:
  341. '         1 = Text (Windows Text)
  342. '         2 = Bitmap Picture
  343. '         3 = Metafile Picture
  344. '         7 = OEM Text (DOS Text)
  345. '---------------------------------------------
  346. '<< Done - Tested OK >>
  347.  
  348. DIM InReg AS RegType, OutReg AS RegType
  349. DIM InRegX AS RegTypeX, OutRegX AS RegTypeX
  350.  
  351. ErrCode% = 0
  352.  
  353. '--- Open Clipboard ---
  354.     InReg.ax = &H1701
  355.     CALL INTERRUPT(&H2F, InReg, OutReg)
  356.     IF OutReg.ax = 0 THEN
  357.         ErrCode% = 1                  '<-- Clipboard is already open
  358.         Clipboard.Size& = 0
  359.         EXIT FUNCTION
  360.     END IF
  361.  
  362. '--- Get Size of Clipboard in current Format ---
  363.     InReg.ax = &H1704
  364.     InReg.dx = Format%
  365.     CALL INTERRUPT(&H2F, InReg, OutReg)
  366.     ClipSize& = (OutReg.dx * 16) + OutReg.ax
  367.  
  368. '--- Close Clipboard ---
  369.     InReg.ax = &H1708
  370.     CALL INTERRUPT(&H2F, InReg, OutReg)
  371.     IF OutReg.ax = 0 THEN
  372.         ErrCode% = 2                  '<-- Clipboard wont close
  373.         Clipboard.Size& = 0
  374.         EXIT FUNCTION
  375.     END IF
  376.  
  377. Clipboard.Size& = ClipSize&
  378.  
  379. END FUNCTION
  380.  
  381. FUNCTION Info.DOSver%
  382.  
  383. '  (c) Carl Gorringe 1/15/96
  384. '--------------------------------------
  385. '  Returns the DOS version times 100.
  386. '  To get decimal representation,
  387. '  devide the number returned by 100.
  388. '--------------------------------------
  389. '<< Done - Tested OK >>
  390.  
  391. DIM InReg AS RegType, OutReg AS RegType
  392.  
  393. InReg.ax = &H3306
  394. CALL INTERRUPT(&H21, InReg, OutReg)
  395. DOSver% = ((OutReg.bx AND 255) * 100) + (OutReg.bx \ 256)
  396. IF DOSver% = 0 THEN
  397.   InReg.ax = &H3000
  398.   CALL INTERRUPT(&H21, InReg, OutReg)
  399.   DOSver% = ((OutReg.ax AND 255) * 100) + (OutReg.ax \ 256)
  400. END IF
  401.  
  402. Info.DOSver% = DOSver%
  403.  
  404. END FUNCTION
  405.  
  406. FUNCTION Info.WinMode%
  407.  
  408. '  (c) Carl Gorringe 1/15/96
  409. '-------------------------------------------------------------
  410. '  Returns the current Windows Mode:
  411. '    0 = Windows not detected
  412. '    1 = Real mode detected (Win 3.0 and earlier only)
  413. '    2 = Standard mode detected. (Win 3.11 and earlier only)
  414. '    3 = 386 enhanced mode detected.
  415. '-------------------------------------------------------------
  416. '<< Done - Tested OK >>
  417.  
  418. DIM InReg AS RegType, OutReg AS RegType
  419.  
  420. DOSver% = Info.DOSver%
  421.  
  422. IF DOSver% >= 300 THEN
  423.   InReg.ax = &H160A
  424.   CALL INTERRUPT(&H2F, InReg, OutReg)
  425.   IF OutReg.ax <> 0 THEN
  426.      WinMode% = 0
  427.   ELSE
  428.      WinMode% = OutReg.cx
  429.   END IF
  430. END IF
  431.  
  432. Info.WinMode% = WinMode%
  433.  
  434. END FUNCTION
  435.  
  436.